home *** CD-ROM | disk | FTP | other *** search
/ Enter 2004 January / enter-2004-01.iso / files / maxima-5.9.0.exe / {app} / share / maxima / 5.9.0 / src / mopers.lisp < prev    next >
Encoding:
Text File  |  2003-02-09  |  5.2 KB  |  128 lines
  1. ;;; -*-  Mode: Lisp; Package: Maxima; Syntax: Common-Lisp; Base: 10 -*- ;;;;
  2. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  3. ;;;     The data in this file contains enhancments.                    ;;;;;
  4. ;;;                                                                    ;;;;;
  5. ;;;  Copyright (c) 1984,1987 by William Schelter,University of Texas   ;;;;;
  6. ;;;     All rights reserved                                            ;;;;;
  7. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  8. ;;;     (c) Copyright 1980 Massachusetts Institute of Technology         ;;;
  9. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  10.  
  11. (in-package "MAXIMA")
  12. (macsyma-module mopers macro)
  13. (load-macsyma-macros defopt)
  14. (load-macsyma-macros-at-runtime 'defopt)
  15.  
  16. ;; This file is the compile-time half of the OPERS package, an interface to the
  17. ;; Macsyma general representaton simplifier.  When new expressions are being
  18. ;; created, the macros in this file or the functions in NOPERS should be called
  19. ;; rather than the entrypoints in SIMP such as SIMPLIFYA or SIMPLUS.
  20.  
  21. ;; The basic functions are ADD, SUB, MUL, DIV, POWER, NCMUL, NCPOWER, INV.
  22. ;; Each of these functions assume that their arguments are simplified.  Some
  23. ;; functions will have a "*" adjoined to the end of the name (as in ADD*).
  24. ;; These do not assume that their arguments are simplified.  The above
  25. ;; functions are the only entrypoints to this package.
  26.  
  27. ;; The functions ADD2, MUL2, and MUL3 are for use internal to this package
  28. ;; and should not be called externally.
  29.  
  30. ;; I have added the macro DEFGRAD as an interface to the $DERIVATIVE function
  31. ;; for use by macsyma programers who want to do a bit of lisp programming. -GJC
  32.  
  33. (defmacro =0 (x) `(equal ,x 0))
  34. (defmacro =1 (x) `(equal ,x 1))
  35.  
  36. ;; Addition -- call ADD with simplified operands; ADD* with unsimplified
  37. ;; operands.
  38.  
  39. (defopt add (&rest terms)
  40.   (cond ((= (length terms) 2) `(add2 . ,(copy-rest-arg terms)))
  41.     (t `(addn (list . , (copy-rest-arg terms)) t))))
  42.  
  43. (defopt add* (&rest terms)
  44.   (cond ((= (length terms) 2) `(add2* . ,(copy-rest-arg terms)))
  45.     (t `(addn (list . ,(copy-rest-arg terms)) nil))))
  46.  
  47. ;; Multiplication -- call MUL or NCMUL with simplified operands; MUL* or NCMUL*
  48. ;; with unsimplified operands.
  49.  
  50. (defopt mul (&rest factors)
  51.   (cond ((= (length factors) 2) `(mul2 . ,(copy-rest-arg factors)))
  52.     ((= (length factors) 3) `(mul3 . ,(copy-rest-arg factors)))
  53.     (t `(muln (list . ,(copy-rest-arg factors)) t))))
  54.  
  55. (defopt mul* (&rest factors)
  56.   (cond ((= (length factors) 2) `(mul2* . ,(copy-rest-arg factors)))
  57.     (t `(muln (list . ,(copy-rest-arg factors)) nil))))
  58.  
  59. ;; the rest here can't be DEFOPT's because there aren't interpreted versions yet.
  60.  
  61. (defmacro inv (x) `(power ,x -1))
  62. (defmacro inv* (x) `(power* ,x -1))
  63.  
  64. (defmacro ncmul (&rest factors)
  65.       (cond ((= (length factors) 2) `(ncmul2 . ,(copy-rest-arg factors)))
  66.         (t `(ncmuln (list . ,(copy-rest-arg factors)) t))))
  67.  
  68. ;; (TAKE '(%TAN) X) = tan(x)
  69. ;; This syntax really loses.  Not only does this syntax lose, but this macro
  70. ;; has to look like a subr.  Otherwise, the definition would look like
  71. ;; (DEFMACRO TAKE ((NIL (OPERATOR)) . ARGS) ...)
  72.  
  73. ;; (TAKE A B) --> (SIMPLIFYA (LIST A B) T)
  74. ;; (TAKE '(%SIN) A) --> (SIMP-%SIN (LIST '(%SIN) A) 1 T)
  75.  
  76. (defmacro take (operator &rest args &aux simplifier)
  77.       (setq simplifier
  78.         (and (not (atom operator))
  79.              (eq (car operator) 'quote)
  80.              (cdr (assq (caadr operator) '((%atan  . simp-%atan)
  81.                            (%tan   . simp-%tan)
  82.                            (%log   . simpln)
  83.                            (mabs   . simpabs)
  84.                            (%sin   . simp-%sin)
  85.                            (%cos   . simp-%cos)
  86.                            ($atan2 . simpatan2)
  87.                            )))))
  88.       (cond (simplifier `(,simplifier (list ,operator . ,args) 1 t))
  89.         (t `(simplifya (list ,operator . ,args) t))))
  90.  
  91. (defmacro min%i () ''((MTIMES SIMP) -1 $%I))            ;-%I
  92. (defmacro 1//2 () ''((RAT SIMP) 1 2))                ;1/2
  93. (defmacro half () ''((RAT SIMP) 1 2))                    ;1/2
  94. (defmacro I//2 () ''((MTIMES SIMP) ((RAT SIMP) 1 2) $%I))    ;%I/2
  95.  
  96. ;; On PDP-10s, this is a function so as to save address space.  A one argument
  97. ;; call is shorter than a two argument call, and this function is called
  98. ;; several places.  In Franz, Multics, and the LISPM, this macros out on the
  99. ;; assumption that calls are more expensive than the additional memory.
  100.  
  101. #+(or Cl Multics Franz NIL)
  102. (defopt simplify (x) `(simplifya ,x nil))
  103.  
  104.  
  105. ;; Multics Lisp is broken in that it doesn't grab the subr definition
  106. ;; when applying.  If the macro definition is there first, it tries that and
  107. ;; loses.
  108. #+Multics (if (get 'simplify 'subr) (remprop 'simplify 'macro))
  109.  
  110. ;; A hand-made DEFSTRUCT for dealing with the Macsyma MDO structure.
  111. ;; Used in GRAM, etc. for storing/retrieving from DO structures.
  112.  
  113. (DEFMACRO MAKE-MDO () '(LIST (LIST 'MDO) NIL NIL NIL NIL NIL NIL NIL))
  114.  
  115. (DEFMACRO MDO-OP (X)     `(CAR (CAR ,X)))
  116.  
  117. (DEFMACRO MDO-FOR (X)    `(CAR (CDR ,X)))
  118. (DEFMACRO MDO-FROM (X)   `(CAR (CDDR ,X)))
  119. (DEFMACRO MDO-STEP (X)   `(CAR (CDDDR ,X)))
  120. (DEFMACRO MDO-NEXT (X)   `(CAR (CDDDDR ,X)))
  121. (DEFMACRO MDO-THRU (X)   `(CAR (CDR (CDDDDR ,X))))
  122. (DEFMACRO MDO-UNLESS (X) `(CAR (CDDR (CDDDDR ,X))))
  123. (DEFMACRO MDO-BODY (X)     `(CAR (CDDDR (CDDDDR ,X))))
  124.  
  125. (DEFMACRO DEFGRAD (NAME ARGUMENTS . BODY)
  126.   `(DEFPROP ,NAME (,ARGUMENTS . ,BODY) GRAD))
  127.  
  128.